home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
SystemCode
/
sendURL.tcl
< prev
next >
Wrap
Text File
|
1997-03-27
|
1KB
|
41 lines
# (WTP 7/30/95) Slightly improved 'sendURL'.
# By accepting a text arg, this can now be used to make sendURL
# hypertext links (useful for "mailto" links in documentation, f'rinstance)
#===============================================================================
set htmlEventSuiteIDs(MOSS) {WWW!}
set htmlEventSuiteIDs(MSIE) {WWW!}
proc sendUrl {{text {}}} {
if {$text == {}} { set text [getSelect] }
if {$text == {}} { set text [prompt {URL?} {}] }
if {[string length $text] == 0} { return }
global htmlEventSuiteIDs browserSig
if {[catch {launchBackApplSigs {MOSS} browserSig}]} {
getApplSig "Please locate your web browser:" browserSig
}
set name [file tail [launchBackAppl $browserSig]]
if {![info exists htmlEventSuiteIDs($browserSig)]} {
alertnote "Can't send URLs to this HTML browser"
return
}
set suite $htmlEventSuiteIDs($browserSig)
AEBuild "'${browserSig}'" $suite {OURL} {----} "“$text”"
switchTo $name
}
proc expandURL {} {
set pos [getPos]
set beg [lineStart $pos]
if {[string length [set whe [search -s -n -f 1 -r 1 -i 1 -m 0 -l [nextLineStart $pos] {[a-zA-Z0-9]+://[a-zA-Z/._0-9~-]+} $beg]]]} {
if {($pos >= [lindex $whe 0]) && ($pos < [lindex $whe 1])} {
eval select $whe
return $whe
}
}
}